(DECLARE (SPECIAL BPORG BPEND INTERNSTR SPECIAL NOCALL REMOB LAPLST LAPKLST
		  LAPQLST LAPSLST L MRKLST COM0 SPREMOB))

(DEFLIST (LAP1 GWD LAPEVAL DEFSYM GVAL MRKLST COM0 SPREMOB) T NOCALL)

(DEFV SPECIAL T)

(DEFV NOCALL NIL)

(DEFV REMOB NIL)

(DEFV LAPLST NIL)	→ Special cells and atom names - for backtrace

(DEFV LAPKLST NIL)	→ Addresses of constants so they can be reused

(OR [GET 'LAPQLST 'VALUE] [DEFV LAPQLST NIL])	→ Quoted exprs - for reuse & GC

(OR [GET 'LAPSLST 'VALUE] [DEFV LAPSLST NIL])	→ Special cells of NOCALLs for GC

(DEFPROP LAP
 (LAMBDA (SL)
  (PROG (L MRKLST COM0 INTERNSTR SPREMOB)
	(SETQ L BPORG)
	(SETQ MRKLST (LIST NIL))
	(SETQ COM0 (GENSYM))
	(SETQ INTERNSTR T)
	(AND [EQ NOCALL T] [SETQ NOCALL '(NIL)])
	(PROG (REMOB)
	      (SETQ COM0 (ERRSET (LAP1) ERRORX))
	      (APPLY# 'REMOB REMOB)
	      (AND [CONSP COM0] [RETURN (FREELIST REMOB)])
	      (MAPATOMS (FUNCTION
			 (LAMBDA (X)
			  (PROG (Y)
				(OR [SETQ Y (GET X 'UNDEF)] [RETURN NIL])
			      L (COND [(*LESS (CAR Y) BPORG)]
				      [(NULL (CDR Y)) (REMPROP X 'UNDEF)]
				      [T (RPLACA Y (CADR Y))
					 (RPLACD Y (CDDR Y))
					 (GO L)])))))
	      (ERR COM0))
	(PUTPROP (CAR SL) (NUMVAL BPORG) (CADR SL))
	(SETQ COM0 NIL)
	(COND [(REMPROP (CAR SL) 'NOCALL)
	       (AND [GET (CAR SL) 'SYM] [SETQ COM0 T])
	       (DEFSYM (CAR SL) BPORG T)]
	      [NOCALL (DEFSYM (CAR SL) BPORG NIL)
		      (AND [MEMB (CAR SL) NOCALL] [SETQ COM0 T])])
	(AND COM0 
	     [TTYMSG T "*WARNING - NOCALL Function " (CAR SL) " Redefined." T])
	(SETQ REMOB (NCONC SPREMOB REMOB))
	(RETURN (PROG1 (LIST (CAR SL) (*DIF L BPORG)) (SETQ BPORG L)))))
 FEXPR)

(DEFPROP LAP1
 (LAMBDA NIL
  (PROG (LL TT)
      A (COND [(NULL (SETQ LL (READ))) (GO END)]
	      [(ATOM LL) (DEFSYM LL L T) (GO A)]
	      [(AND NOCALL 
		    [OR [EQ (CAR LL) 'CALL] [EQ (CAR LL) 'JCALL]]
		    [EQ (CAR (SETQ TT (CADDR LL))) 'E]
		    [ATOM (CADR TT)]
		    [NOT (GET (CADR TT) 'CALL)])
	       (RPLACA TT 'NOCALL)
	       (SETQ LL 
		     (PROG1 (COND [(EQ (CAR LL) 'CALL) (LIST 'PUSHJ 'P TT)]
				  [T (LIST 'JRST 0Q TT)])
			    (FREELIST LL)))])
	(DEPOSIT L (MAKNUM (GWD LL) 'FIXNUM))
	(FREELIST LL)
	(SETQ LL NIL)
	(SETQ L (ADD1 L))
	(COND [(*LESS L BPEND) (GO A)])
      B (TTYMSG T "BINARY PROGRAM SPACE EXCEEDED" T)
	(ERR 'ERRORX)
    END (DEFSYM COM0 L T)
	(COND [(*LESS (*DIF BPEND BPORG) (LENGTH MRKLST)) (GO B)])
    EN1 (COND [(NULL (SETQ MRKLST (CDR MRKLST))) (RETURN NIL)]
	      [(NOT (MEMB (CADDAR MRKLST) REMOB))
	       (SETQ LAPKLST (CONS (CONS (CAR MRKLST) L) LAPKLST))])
	(DEPOSIT L (MAKNUM (GWD (CAR MRKLST)) 'FIXNUM))
	(SETQ L (ADD1 L))
	(GO EN1)))
 EXPR)

(DEFPROP GWD
 (LAMBDA (X)
  (NUMVAL (PROG (WRD FLD)
		(SETQ FLD 
		      '((22Q . -1Q) (27Q . 17Q) (0Q . 777777Q) (22Q . 777777Q)))
		(SETQ WRD 0Q)
		(MAPC (FUNCTION
		       (LAMBDA (ZZ)
			(SETQ WRD 
			      (*PLUS WRD 
				     (LSH (BOOLE 1Q (CDAR FLD) (LAPEVAL ZZ))
					  (CAAR FLD))))
			(SETQ FLD (CDR FLD))))
		      X)
		(COND [(EQ (CADDDR X) 'S) (SETQ WRD (*DIF WRD (EXAMINE 11Q)))])
		(RETURN WRD))))
 EXPR)

(DEFPROP LAPEVAL
 (LAMBDA (X)
  (COND [(NUMBERP X) X]
	[(ATOM X) (GVAL X T)]
	[(MEMQ (CAR X) '(E QUOTE))
	 (MAKNUM (COND [(OR [CONSP (SETQ X (CADR X))]
			    [AND [NUMBERP X] [NOT (INUMP X)]]
			    [AND [LITATOM X] [GET X 'NOCALL]])
			(PROG (Y)
			      (SETQ Y LAPQLST)
			    A (COND [(NULL Y)
				     (RETURN (CAR (SETQ LAPQLST 
							(CONS X LAPQLST))))]
				    [(AND [EQUAL X (CAR Y)]
					  [OR [NOT (NUMBERP X)]
					      [EQ (CADR X) (CADAR Y)]])
				     (RETURN (CAR Y))])
			      (SETQ Y (CDR Y))
			      (GO A))]
		       [T X])
		 'FIXNUM)]
	[(EQ (CAR X) 'SPECIAL)
	 (PROG (Y)
	       (COND [(NULL (SETQ Y (GET (SETQ X (CADR X)) 'VALUE)))
		      (PUTPROP X (SETQ Y (CONS NIL (UNBOUND))) 'VALUE)]
		     [T (RPLACA Y NIL)])
	       (AND SPECIAL 
		    [NOT (ASSOC Y LAPLST)]
		    [SETQ LAPLST (CONS (CONS Y X) LAPLST)])
	       (COND [(AND [GET X 'NOCALL] [NOT (MEMB Y LAPSLST)])
		      (SETQ SPREMOB (CONS X SPREMOB))
		      (SETQ LAPSLST (CONS Y LAPSLST))])
	       (RETURN (MAKNUM Y 'FIXNUM)))]
	[(EQ (CAR X) 'C)
	 (PROG (N CPTR)
	       (SETQ CPTR LAPKLST)
	   L11 (COND [(NULL CPTR) (GO L12)]
		     [(EQUAL (CDR X) (CAAR CPTR)) (RETURN (CDAR CPTR))])
	       (SETQ CPTR (CDR CPTR))
	       (GO L11)
	   L12 (GVAL COM0 NIL)
	       (SETQ N 0Q)
	       (SETQ CPTR MRKLST)
	     A (COND [(NULL (CDR CPTR)) (RPLACD CPTR (LIST (CDR X))) (RETURN N)]
		)
	       (COND [(EQUAL (CDR X) (CADR CPTR)) (RETURN N)])
	       (SETQ N (ADD1 N))
	       (SETQ CPTR (CDR CPTR))
	       (GO A))]
	[(EQ (CAR X) 'NOCALL)
	 (PROG (Y)
	       (COND [(SETQ Y (GETL (SETQ X (CADR X)) '(SUBR FSUBR LSUBR)))
		      (AND [NOT (MEMB X NOCALL)] [SETQ NOCALL (CONS X NOCALL)])
		      (RETURN (MAKNUM (CADR Y) 'FIXNUM))]
		     [T (RETURN (GVAL X NIL))]))]
	[T (*PLUS (LAPEVAL (CAR X)) (LAPEVAL (CDR X)))]))
 EXPR)

(DEFPROP DEFSYM
 (LAMBDA (SYM VAL FLG)
  (PROG (Z Y)
	(COND [(SETQ Z (GET SYM 'UNDEF)) (SETQ Y Z) (GO PATCH)])
      A (RETURN (COND [FLG (SETQ REMOB (CONS SYM REMOB)) (PUTPROP SYM VAL 'SYM)]
		 ))
  PATCH (COND [(NULL Z)
	       (REMPROP SYM 'UNDEF)
	       (PROGN (FREELIST Y) (SETQ Y NIL))
	       (GO A)])
	(DEPOSIT (CAR Z) (*PLUS (EXAMINE (CAR Z)) VAL))
	(SETQ Z (CDR Z))
	(GO PATCH)))
 EXPR)

(DEFPROP GVAL
 (LAMBDA (SYM FLG)
  (COND [(AND FLG [GET SYM 'SYM])]
	[T (PUTPROP SYM (CONS L (GET SYM 'UNDEF)) 'UNDEF)
	   0Q]))
 EXPR)

(DEFPROP OPS
 (LAMBDA (L)
  (PROG NIL
      A (COND [(NULL L) (RETURN T)])
	(PUTPROP (CAR L) (CADR L) 'SYM)
	(SETQ L (CDDR L))
	(GO A)))
 FEXPR)

(DEFPROP REMLAP
 (LAMBDA NIL
  (PROG (Z)
	(SETQ Z '(LAP LAP1 GWD LAPEVAL DEFSYM GVAL))
      A (COND [(NULL Z) (GO B)])
	(REMPROP (CAR Z) 'EXPR)
	(REMPROP (CAR Z) 'FEXPR)
	(SETQ Z (CDR Z))
	(GO A)
      B (REMOB OPS REMLAP WRD FLD SL VAL FLG END EN1 L11 L12 PATCH CPTR LL TT ZZ)))
 EXPR)

(OPS MOVE 200000Q MOVEI 201000Q MOVEM 202000Q JRST 254000Q CALL 34000Q JCALL
     35000Q PUSHJ 260000Q POPJ 263000Q PUSH 261000Q POP 262000Q JSP 265000Q EXCH
     250000Q JUMPE 322000Q JUMPN 326000Q SOJE 362000Q SOJN 366000Q CAIE 302000Q
     CAIN 306000Q CAME 312000Q CAMN 316000Q CALLF 36000Q JCALLF 37000Q HRRZ@
     550020Q HLRZ@ 554020Q TDZA 634000Q SUB 274000Q HRRZ 550000Q HLRZ 554000Q
     CLEARM 402000Q CLEARB 403000Q ADD 270000Q MOVNI 211000Q CALLF@ 36020Q
     JCALLF@ 37020Q HRRM@ 542020Q HRLM@ 506020Q HRRZS@ 553020Q HLLZS@ 513020Q
     HRRM 542000Q HRLM 506000Q HLRM 546000Q HRLZ 514000Q HLLZS 513000Q HRRZS
     553000Q S 11Q D 12Q P 14Q)





→ LAP code includes a few hand modifications for efficiency.
→ They are all marked as such.   -RAL



(LAP LAP FSUBR)
	(JSP 6Q SPECBIND)
	(0Q 0Q (SPECIAL L) S)
	(0Q 0Q (SPECIAL MRKLST) S)
	(0Q 0Q (SPECIAL COM0) S)
	(0Q 0Q (SPECIAL INTERNSTR) S)
	(0Q 0Q (SPECIAL SPREMOB) S)
	(PUSH P 1Q)
	(MOVE 1Q (SPECIAL BPORG) S)
	(MOVEM 1Q (SPECIAL L) S)
	(MOVEI 1Q (QUOTE NIL))
	(CALL 1Q (E NCONS) S)
	(MOVEM 1Q (SPECIAL MRKLST) S)
	(CALL 0Q (E GENSYM) S)
	(MOVEM 1Q (SPECIAL COM0) S)
	(MOVEI 1Q (QUOTE T) S)
	(MOVEM 1Q (SPECIAL INTERNSTR) S)
	(MOVE 1Q (SPECIAL NOCALL) S)
	(CAIE 1Q (QUOTE T) S)
	(JRST 0Q TAG10)
	(MOVEI 1Q (QUOTE (NIL)) S)
	(MOVEM 1Q (SPECIAL NOCALL) S)
 TAG10	(JSP 6Q SPECBIND)
	(0Q 0Q (SPECIAL REMOB) S)
	(PUSH P (C 0Q 0Q TAG14 0Q))
	(MOVEI 1Q (QUOTE ERRORX) S)
	(JSP 13Q *ERRSET1)
	(CALL 0Q (E LAP1) S)
	(JRST 0Q *ERRSET2)
 TAG14	(MOVEM 1Q (SPECIAL COM0) S)
	(MOVE 1Q (SPECIAL REMOB) S)
	(CALL 17Q (E REMOB) S)
	(MOVE 1Q (SPECIAL COM0) S)
	(CALL 1Q (E CONSP) S)
	(JUMPE 1Q TAG16)
	(MOVE 1Q (SPECIAL REMOB) S)
	(CALL 1Q (E FREELIST) S)
	(JRST 0Q TAG11)
 TAG16	(PUSH P (SPECIAL OBLIST) S)
 TAG1	(MOVE 1Q 0Q P)
	(JUMPE 1Q TAG23)
	(HLRZ@ 1Q 1Q)
	(PUSH P 1Q)
 TAG2	(MOVE 1Q 0Q P)
	(JUMPE 1Q TAG30)
	(HLRZ@ 1Q 1Q)
	(PUSH P 1Q)
	(PUSH P (C 0Q 0Q (QUOTE NIL) 0Q))
	(MOVEI 2Q (QUOTE UNDEF) S)
	(CALL 2Q (E GET) S)
	(MOVEM 1Q 0Q P)
	(JUMPN 1Q TAG34)
	(JRST 0Q TAG32)
 TAG34
 TAG3	(MOVE 2Q (SPECIAL BPORG) S)
	(HLRZ@ 1Q 0Q P)
	(CALL 2Q (E *LESS) S)
	(JUMPN 1Q TAG35)
	(HRRZ@ 1Q 0Q P)
	(JUMPN 1Q TAG36)
	(MOVEI 2Q (QUOTE UNDEF) S)
	(MOVE 1Q -1Q P)
	(CALL 2Q (E REMPROP) S)
	(JRST 0Q TAG35)
 TAG36	(HLRZ@ 1Q 1Q)
	(HRLM@ 1Q 0Q P)
	(HRRZ@ 1Q 0Q P)
	(HRRZ@ 1Q 1Q)
	(HRRM@ 1Q 0Q P)
	(JRST 0Q TAG3)
 TAG35
 TAG32	(HRRZ@ 1Q -2Q P)
	(MOVEM 1Q -2Q P)
	(SUB P (C 2Q 0Q 2Q 0Q))
	(JRST 0Q TAG2)
 TAG30	(HRRZ@ 1Q -1Q P)
	(MOVEM 1Q -1Q P)
	(SUB P (C 1Q 0Q 1Q 0Q))
	(JRST 0Q TAG1)
 TAG23	(SUB P (C 1Q 0Q 1Q 0Q))
	(MOVE 1Q (SPECIAL COM0) S)
	(CALL 1Q (E ERR) S)
 TAG11	(PUSHJ P SPECSTR)
	(HLRZ@ 1Q 0Q P)
	(PUSH P 1Q)
	(MOVE 1Q (SPECIAL BPORG) S)
	(CALL 1Q (E NUMVAL) S)
	(HRRZ@ 3Q -1Q P)
	(HLRZ@ 3Q 3Q)
	(MOVE 2Q 1Q)
	(POP P 1Q)
	(CALL 3Q (E PUTPROP) S)
	(CLEARM 1Q (SPECIAL COM0) S)
	(MOVEI 2Q (QUOTE NOCALL) S)
	(HLRZ@ 1Q 0Q P)
	(CALL 2Q (E REMPROP) S)
	(JUMPE 1Q TAG41)
	(MOVEI 2Q (QUOTE SYM) S)
	(HLRZ@ 1Q 0Q P)
	(CALL 2Q (E GET) S)
	(JUMPE 1Q TAG43)
	(MOVEI 1Q (QUOTE T) S)
	(MOVEM 1Q (SPECIAL COM0) S)
 TAG43	(MOVEI 3Q (QUOTE T) S)
	(MOVE 2Q (SPECIAL BPORG) S)
	(HLRZ@ 1Q 0Q P)
	(CALL 3Q (E DEFSYM) S)
	(JRST 0Q TAG40)
 TAG41	(MOVE 1Q (SPECIAL NOCALL) S)
	(JUMPE 1Q TAG44)
	(MOVEI 3Q (QUOTE NIL))
	(MOVE 2Q (SPECIAL BPORG) S)
	(HLRZ@ 1Q 0Q P)
	(CALL 3Q (E DEFSYM) S)
	(MOVE 2Q (SPECIAL NOCALL) S)
	(HLRZ@ 1Q 0Q P)
	(CALL 2Q (E MEMB) S)
	(JUMPE 1Q TAG46)
	(MOVEI 1Q (QUOTE T) S)
	(MOVEM 1Q (SPECIAL COM0) S)
 TAG46
 TAG44
 TAG40	(MOVE 1Q (SPECIAL COM0) S)
	(JUMPE 1Q TAG50)
	(MOVEI 2Q (QUOTE NIL))
	(MOVEI 1Q (QUOTE NIL))
	(CALL 2Q (E OUTC) S)
	(PUSH P 1Q)
	(CALL 0Q (E TALK) S)
	(CALL 0Q (E TERPRI) S)
	(PUSH P (C 0Q 0Q TAG51 0Q))
	(MOVEI D (QUOTE "*WARNING - NOCALL Function ") S)
	(PUSH P D)
	(MOVNI 6Q 1Q)
	(JCALL 16Q (E PRINAC) S)
 TAG51	(PUSH P (C 0Q 0Q TAG52 0Q))
	(HLRZ@ 1Q -2Q P)
	(PUSH P 1Q)
	(MOVNI 6Q 1Q)
	(JCALL 16Q (E PRINA) S)
 TAG52	(PUSH P (C 0Q 0Q TAG53 0Q))
	(MOVEI D (QUOTE " Redefined.") S)
	(PUSH P D)
	(MOVNI 6Q 1Q)
	(JCALL 16Q (E PRINAC) S)
 TAG53	(CALL 0Q (E TERPRI) S)
	(MOVEI 2Q (QUOTE NIL))
	(POP P 1Q)
	(CALL 2Q (E OUTC) S)
 TAG50	(MOVE 2Q (SPECIAL REMOB) S)
	(MOVE 1Q (SPECIAL SPREMOB) S)
	(CALL 2Q (E *NCONC) S)
	(MOVEM 1Q (SPECIAL REMOB) S)
	(HLRZ@ 1Q 0Q P)
	(MOVE 2Q (SPECIAL BPORG) S)
	(PUSH P 1Q)
	(MOVE 1Q (SPECIAL L) S)
	(CALL 2Q (E *DIF) S)
	(CALL 1Q (E NCONS) S)
	(POP P 2Q)
	(CALL 2Q (E XCONS) S)
	(PUSH P 1Q)
	(MOVE 1Q (SPECIAL L) S)
	(MOVEM 1Q (SPECIAL BPORG) S)
	(POP P 1Q)
	(SUB P (C 1Q 0Q 1Q 0Q))
	(JRST 0Q SPECSTR)
	NIL

(LAP LAP1 SUBR)
	(PUSH P (C 0Q 0Q (QUOTE NIL) 0Q))
	(PUSH P (C 0Q 0Q (QUOTE NIL) 0Q))
 TAG1	(CALL 0Q (E READ) S)
	(MOVEM 1Q 0Q P)
	(JUMPE 1Q TAG3)
	(CALL 1Q (E ATOM) S)
	(JUMPE 1Q TAG11)
	(MOVEI 3Q (QUOTE T) S)
	(MOVE 2Q (SPECIAL L) S)
	(MOVE 1Q 0Q P)
	(CALL 3Q (E DEFSYM) S)
	(JRST 0Q TAG1)
 TAG11	(MOVE 1Q (SPECIAL NOCALL) S)
	(JUMPE 1Q TAG12)
	(HLRZ@ 1Q 0Q P)
	(CAIN 1Q (QUOTE CALL) S)
	(JRST 0Q TAG17)
	(CAIE 1Q (QUOTE JCALL) S)
	(JRST 0Q TAG12)
 TAG17	(HRRZ@ 1Q 0Q P)
	(CALL 1Q (E CADR) S)
	(HLRZ@ 2Q 1Q)
	(MOVEM 1Q -1Q P)
	(CAIE 2Q (QUOTE E) S)
	(JRST 0Q TAG12)
	(CALL 1Q (E CADR) S)
	(CALL 1Q (E ATOM) S)
	(JUMPE 1Q TAG12)
	(MOVEI 2Q (QUOTE CALL) S)
	(HRRZ@ 1Q -1Q P)
	(HLRZ@ 1Q 1Q)
	(CALL 2Q (E GET) S)
	(JUMPN 1Q TAG12)
	(MOVEI 1Q (QUOTE NOCALL) S)
	(HRLM@ 1Q -1Q P)
	(HLRZ@ 1Q 0Q P)
	(CAIE 1Q (QUOTE CALL) S)
	(JRST 0Q TAG25)
	(MOVE 1Q -1Q P)
	(CALL 1Q (E NCONS) S)
	(MOVEI 2Q (QUOTE P) S)
	(CALL 2Q (E XCONS) S)
	(MOVEI 2Q (QUOTE PUSHJ) S)
	(CALL 2Q (E XCONS) S)
	(JRST 0Q TAG24)
 TAG25	(MOVE 1Q -1Q P)
	(CALL 1Q (E NCONS) S)
	(MOVEI 2Q (QUOTE 0Q))
	(CALL 2Q (E XCONS) S)
	(MOVEI 2Q (QUOTE JRST) S)
	(CALL 2Q (E XCONS) S)
 TAG24	(PUSH P 1Q)
	(MOVE 1Q -1Q P)
	(CALL 1Q (E FREELIST) S)
	(POP P -1Q P)
 TAG12	(MOVE 1Q 0Q P)
	(CALL 1Q (E GWD) S) 		→ HAND HACK
	(MOVE 3Q 1Q)			→
	(MOVE 1Q (SPECIAL L) S)		→
	(PUSHJ P NUMVAL)		→
	(MOVEM 3Q 0Q 1Q)		→ END HAND HACK
	(MOVE 1Q 0Q P)
	(CALL 1Q (E FREELIST) S)
	(CLEARM 1Q 0Q P)
	(MOVE 1Q (SPECIAL L) S)
	(CALL 1Q (E ADD1) S)
	(MOVEM 1Q (SPECIAL L) S)
	(MOVE 2Q (SPECIAL BPEND) S)
	(CALL 2Q (E *LESS) S)
	(JUMPN 1Q TAG1)
 TAG2	(MOVEI 2Q (QUOTE NIL))
	(MOVEI 1Q (QUOTE NIL))
	(CALL 2Q (E OUTC) S)
	(PUSH P 1Q)
	(CALL 0Q (E TALK) S)
	(CALL 0Q (E TERPRI) S)
	(PUSH P (C 0Q 0Q TAG30 0Q))
	(MOVEI D (QUOTE "BINARY PROGRAM SPACE EXCEEDED") S)
	(PUSH P D)
	(MOVNI 6Q 1Q)
	(JCALL 16Q (E PRINAC) S)
 TAG30	(CALL 0Q (E TERPRI) S)
	(MOVEI 2Q (QUOTE NIL))
	(POP P 1Q)
	(CALL 2Q (E OUTC) S)
	(MOVEI 1Q (QUOTE ERRORX) S)
	(CALL 1Q (E ERR) S)
 TAG3	(MOVEI 3Q (QUOTE T) S)
	(MOVE 2Q (SPECIAL L) S)
	(MOVE 1Q (SPECIAL COM0) S)
	(CALL 3Q (E DEFSYM) S)
	(MOVE 2Q (SPECIAL BPORG) S)
	(MOVE 1Q (SPECIAL BPEND) S)
	(CALL 2Q (E *DIF) S)
	(PUSH P 1Q)
	(MOVE 1Q (SPECIAL MRKLST) S)
	(CALL 1Q (E LENGTH) S)
	(POP P 2Q)
	(CALL 2Q (E *GREAT) S)
	(JUMPN 1Q TAG2)
 TAG4	(HRRZ@ 1Q (SPECIAL MRKLST) S)
	(MOVEM 1Q (SPECIAL MRKLST) S)
	(JUMPE 1Q TAG6)
	(MOVE 2Q (SPECIAL REMOB) S)
	(CALL 1Q (E CADDAR) S)
	(CALL 2Q (E MEMB) S)
	(JUMPN 1Q TAG33)
	(MOVE 2Q (SPECIAL L) S)
	(HLRZ@ 1Q (SPECIAL MRKLST) S)
	(CALL 2Q (E CONS) S)
	(MOVE 2Q (SPECIAL LAPKLST) S)
	(CALL 2Q (E CONS) S)
	(MOVEM 1Q (SPECIAL LAPKLST) S)
 TAG33	(HLRZ@ 1Q (SPECIAL MRKLST) S)
	(CALL 1Q (E GWD) S)		→ HAND HACK
	(MOVE 3Q 1Q)			→
	(MOVE 1Q (SPECIAL L) S)		→
	(PUSHJ P NUMVAL)		→
	(MOVEM 3Q 0Q 1Q)		→ END HAND HACK
	(MOVE 1Q (SPECIAL L) S)
	(CALL 1Q (E ADD1) S)
	(MOVEM 1Q (SPECIAL L) S)
	(JRST 0Q TAG4)
 TAG6	(MOVEI 1Q (QUOTE NIL))
	(SUB P (C 2Q 0Q 2Q 0Q))
	(POPJ P)
	NIL

(LAP GWD SUBR) 				→ GWD IS ENTIRELY HAND CODED
	(PUSH P (C 0Q)) 
	(PUSH P 1Q) 
	(PUSHJ P TAG3) 
	(HRLM 1Q -1Q P)
	(PUSHJ P TAG3) 
	(242000Q 1Q 27Q) 		→ (LSH)
	(436000Q 1Q -1Q P) 		→ (IORM)
	(PUSHJ P TAG3) 
	(HRRM 1Q -1Q P)
	(PUSHJ P TAG3) 
	(CAIE 1Q S)
	(JRST 0Q TAG2)
	(210000Q 2Q S)			→ (MOVN)
	(272000Q 2Q -1Q P)		→ (ADDM)
 TAG2	(HRLZ 1Q 1Q)
	(436000Q 1Q -1Q P) 		→ (IORM)
 TAG4	(POP P 1Q) 
	(POP P 1Q) 
	(POPJ P) 
 TAG5	(POP P 1Q) 
	(JRST 0Q TAG4) 
 TAG3	(MOVE 2Q -1Q P) 
	(JUMPE 2Q TAG5) 
	(HLRZ 1Q 0Q 2Q) 
	(HRRZ 2Q 0Q 2Q) 
	(MOVEM 2Q -1Q P) 
	(CALL 1Q (E LAPEVAL) S) 
	(JRST 0Q NUMVAL) 
	NIL 

(LAP LAPEVAL SUBR) 
	(PUSH P 1Q) 
	(CALL 1Q (E NUMBERP) S) 
	(JUMPE 1Q TAG6) 
	(MOVE 1Q 0Q P) 
	(JRST 0Q TAG5) 
 TAG6 	(MOVE 1Q 0Q P) 
	(CALL 1Q (E ATOM) S) 
	(JUMPE 1Q TAG7) 
	(MOVEI 2Q (QUOTE T) S)
	(MOVE 1Q 0Q P) 
	(CALL 2Q (E GVAL) S) 
	(JRST 0Q TAG5) 
 TAG7 	(MOVEI 2Q (QUOTE (E QUOTE)) S) 
	(HLRZ@ 1Q 0Q P) 
	(CALL 2Q (E MEMQ) S) 
	(JUMPE 1Q TAG10) 
	(HRRZ@ 1Q 0Q P) 
	(HLRZ@ 1Q 1Q) 
	(MOVEM 1Q 0Q P) 
	(CALL 1Q (E CONSP) S) 
	(JUMPN 1Q TAG15) 
	(MOVE 1Q 0Q P) 
	(CALL 1Q (E NUMBERP) S) 
	(JUMPE 1Q TAG8) 
	(MOVE 1Q 0Q P) 
	(CALL 1Q (E INUMP) S) 
	(JUMPE 1Q TAG15)
 TAG8	(MOVE 1Q 0Q P)
	(CALL 1Q (E LITATOM) S)
	(JUMPE 1Q TAG14)
	(MOVE 1Q 0Q P)
	(MOVEI 2Q (QUOTE NOCALL) S)
	(CALL 2Q (E GET) S)
	(JUMPE 1Q TAG14)
 TAG15 	(PUSH P (SPECIAL LAPQLST) S) 
 TAG1 	(MOVE 1Q 0Q P) 
	(JUMPN 1Q TAG24) 
	(MOVE 2Q (SPECIAL LAPQLST) S) 
	(MOVE 1Q -1Q P) 
	(CALL 2Q (E CONS) S) 
	(MOVEM 1Q (SPECIAL LAPQLST) S) 
	(HLRZ@ 1Q 1Q) 
	(JRST 0Q TAG20) 
 TAG24 	(HLRZ@ 2Q 1Q) 
	(MOVE 1Q -1Q P) 
	(CALL 2Q (E EQUAL) S) 
	(JUMPE 1Q TAG25) 
	(MOVE 1Q -1Q P) 
	(CALL 1Q (E NUMBERP) S) 
	(JUMPE 1Q TAG30) 
	(HLRZ@ 1Q 0Q P) 
	(CALL 1Q (E CADR) S) 
	(HRRZ@ 2Q -1Q P) 
	(HLRZ@ 2Q 2Q) 
	(CAME 2Q 1Q) 
	(JRST 0Q TAG25) 
 TAG30 	(HLRZ@ 1Q 0Q P) 
	(JRST 0Q TAG20) 
 TAG25 	(HRRZ@ 1Q 0Q P) 
	(MOVEM 1Q 0Q P) 
	(JRST 0Q TAG1) 
 TAG20 	(SUB P (C 1Q 0Q 1Q 0Q)) 
	(JRST 0Q TAG13) 
 TAG14 	(MOVE 1Q 0Q P) 
 TAG13 	(MOVEI 2Q (QUOTE FIXNUM) S) 
	(CALL 2Q (E MAKNUM) S) 
	(JRST 0Q TAG5) 
 TAG10 	(HLRZ@ 1Q 0Q P) 
	(CAIE 1Q (QUOTE SPECIAL) S) 
	(JRST 0Q TAG32) 
	(PUSH P (C 0Q 0Q (QUOTE NIL) 0Q)) 
	(HRRZ@ 1Q -1Q P) 
	(HLRZ@ 1Q 1Q) 
	(MOVEI 2Q (QUOTE VALUE) S) 
	(MOVEM 1Q -1Q P) 
	(CALL 2Q (E GET) S) 
	(MOVEM 1Q 0Q P) 
	(JUMPN 1Q TAG37) 
	(CALL 0Q (E UNBOUND) S) 
	(MOVEI 2Q (QUOTE NIL)) 
	(CALL 2Q (E XCONS) S) 
	(MOVEI 3Q (QUOTE VALUE) S) 
	(MOVE 2Q 1Q) 
	(MOVEM 1Q 0Q P) 
	(MOVE 1Q -1Q P) 
	(CALL 3Q (E PUTPROP) S) 
	(JRST 0Q TAG36) 
 TAG37 	(HRRZS@ 0Q 1Q) 
 TAG36 	(MOVE 1Q (SPECIAL SPECIAL) S) 
	(JUMPE 1Q TAG42) 
	(MOVE 2Q (SPECIAL LAPLST) S) 
	(MOVE 1Q 0Q P) 
	(CALL 2Q (E ASSOC) S) 
	(JUMPN 1Q TAG44) 
	(MOVE 2Q -1Q P) 
	(MOVE 1Q 0Q P) 
	(CALL 2Q (E CONS) S) 
	(MOVE 2Q (SPECIAL LAPLST) S) 
	(CALL 2Q (E CONS) S) 
	(MOVEM 1Q (SPECIAL LAPLST) S) 
 TAG44 
 TAG42 	(MOVEI 2Q (QUOTE NOCALL) S) 
	(MOVE 1Q -1Q P) 
	(CALL 2Q (E GET) S) 
	(JUMPE 1Q TAG46) 
	(MOVE 2Q (SPECIAL LAPSLST) S) 
	(MOVE 1Q 0Q P) 
	(CALL 2Q (E MEMB) S) 
	(JUMPN 1Q TAG46) 
	(MOVE 2Q (SPECIAL SPREMOB) S) 
	(MOVE 1Q -1Q P) 
	(CALL 2Q (E CONS) S) 
	(MOVEM 1Q (SPECIAL SPREMOB) S) 
	(MOVE 2Q (SPECIAL LAPSLST) S) 
	(MOVE 1Q 0Q P) 
	(CALL 2Q (E CONS) S) 
	(MOVEM 1Q (SPECIAL LAPSLST) S) 
 TAG46 	(MOVEI 2Q (QUOTE FIXNUM) S) 
	(MOVE 1Q 0Q P) 
	(CALL 2Q (E MAKNUM) S) 
	(SUB P (C 1Q 0Q 1Q 0Q)) 
	(JRST 0Q TAG5) 
 TAG32 	(CAIE 1Q (QUOTE C) S) 
	(JRST 0Q TAG47) 
	(PUSH P (SPECIAL LAPKLST) S) 
	(PUSH P (C 0Q 0Q (QUOTE NIL) 0Q)) 
 TAG2 	(MOVE 1Q -1Q P) 
	(JUMPE 1Q TAG3) 
	(HLRZ@ 2Q 1Q) 
	(HLRZ@ 2Q 2Q) 
	(HRRZ@ 1Q -2Q P) 
	(CALL 2Q (E EQUAL) S) 
	(JUMPE 1Q TAG54) 
	(HLRZ@ 1Q -1Q P) 
	(HRRZ@ 1Q 1Q) 
	(JRST 0Q TAG50) 
 TAG54 	(HRRZ@ 1Q -1Q P) 
	(MOVEM 1Q -1Q P) 
	(JRST 0Q TAG2) 
 TAG3	(MOVEI 2Q (QUOTE NIL))
	(MOVE 1Q (SPECIAL COM0) S) 
	(CALL 2Q (E GVAL) S) 
	(MOVEI 1Q (QUOTE 0Q)) 
	(MOVEM 1Q 0Q P) 
	(MOVE 1Q (SPECIAL MRKLST) S) 
	(MOVEM 1Q -1Q P) 
 TAG4 	(HRRZ@ 1Q -1Q P) 
	(JUMPN 1Q TAG56) 
	(HRRZ@ 1Q -2Q P) 
	(CALL 1Q (E NCONS) S) 
	(HRRM@ 1Q -1Q P) 
	(MOVE 1Q 0Q P) 
	(JRST 0Q TAG50) 
 TAG56 	(HRRZ@ 2Q -1Q P) 
	(HLRZ@ 2Q 2Q) 
	(HRRZ@ 1Q -2Q P) 
	(CALL 2Q (E EQUAL) S) 
	(JUMPE 1Q TAG60) 
	(MOVE 1Q 0Q P) 
	(JRST 0Q TAG50) 
 TAG60 	(MOVE 1Q 0Q P) 
	(CALL 1Q (E ADD1) S) 
	(MOVEM 1Q 0Q P) 
	(HRRZ@ 1Q -1Q P) 
	(MOVEM 1Q -1Q P) 
	(JRST 0Q TAG4) 
 TAG50 	(SUB P (C 2Q 0Q 2Q 0Q)) 
	(JRST 0Q TAG5) 
 TAG47 	(CAIE 1Q (QUOTE NOCALL) S) 
	(JRST 0Q TAG61) 
	(PUSH P (C 0Q 0Q (QUOTE NIL) 0Q)) 
	(HRRZ@ 1Q -1Q P) 
	(HLRZ@ 1Q 1Q) 
	(MOVEI 2Q (QUOTE (SUBR FSUBR LSUBR)) S) 
	(MOVEM 1Q -1Q P) 
	(CALL 2Q (E GETL) S) 
	(MOVEM 1Q 0Q P) 
	(JUMPE 1Q TAG66) 
	(MOVE 2Q (SPECIAL NOCALL) S) 
	(MOVE 1Q -1Q P) 
	(CALL 2Q (E MEMB) S) 
	(JUMPN 1Q TAG70) 
	(MOVE 2Q (SPECIAL NOCALL) S) 
	(MOVE 1Q -1Q P) 
	(CALL 2Q (E CONS) S) 
	(MOVEM 1Q (SPECIAL NOCALL) S) 
 TAG70 	(MOVEI 2Q (QUOTE FIXNUM) S) 
	(HRRZ@ 1Q 0Q P) 
	(HLRZ@ 1Q 1Q) 
	(CALL 2Q (E MAKNUM) S) 
	(JRST 0Q TAG62) 
 TAG66	(MOVEI 2Q (QUOTE NIL))
	(MOVE 1Q -1Q P) 
	(CALL 2Q (E GVAL) S) 
	(JRST 0Q TAG62) 
 TAG62 	(SUB P (C 1Q 0Q 1Q 0Q)) 
	(JRST 0Q TAG5) 
 TAG61 	(CALL 1Q (E LAPEVAL) S) 
	(PUSH P 1Q) 
	(HRRZ@ 1Q -1Q P) 
	(CALL 1Q (E LAPEVAL) S) 
	(POP P 2Q) 
	(CALL 2Q (E *PLUS) S) 
 TAG5 	(SUB P (C 1Q 0Q 1Q 0Q)) 
	(POPJ P) 
	NIL 

(LAP DEFSYM SUBR) 
	(PUSH P 1Q) 
	(PUSH P 2Q) 
	(PUSH P 3Q) 
	(PUSH P (C 0Q 0Q (QUOTE NIL) 0Q)) 
	(PUSH P (C 0Q 0Q (QUOTE NIL) 0Q)) 
	(MOVEI 2Q (QUOTE UNDEF) S) 
	(CALL 2Q (E GET) S) 
	(MOVEM 1Q 0Q P) 
	(MOVEM 1Q -1Q P)
	(JUMPN 1Q TAG2) 
 TAG1 	(MOVE 1Q -2Q P) 
	(JUMPE 1Q TAG10) 
	(MOVE 2Q (SPECIAL REMOB) S) 
	(MOVE 1Q -4Q P) 
	(CALL 2Q (E CONS) S) 
	(MOVEM 1Q (SPECIAL REMOB) S) 
	(MOVEI 3Q (QUOTE SYM) S) 
	(MOVE 2Q -3Q P) 
	(MOVE 1Q -4Q P) 
	(CALL 3Q (E PUTPROP) S) 
 TAG10 	(JRST 0Q TAG3) 
 TAG2	(MOVE 1Q -3Q P)			→ HAND HACK
	(PUSHJ P NUMVAL)		→
	(MOVE 5Q 1Q)			→
	(MOVE 1Q 0Q P) 			→
 TAG99	(JUMPN 1Q TAG12) 		→ END HAND HACK
	(MOVEI 2Q (QUOTE UNDEF) S) 
	(MOVE 1Q -4Q P) 
	(CALL 2Q (E REMPROP) S) 
	(MOVE 1Q -1Q P)
	(CALL 1Q (E FREELIST) S)
	(CLEARM 1Q -1Q P)
	(JRST 0Q TAG1) 
 TAG12 	(HLRZ@ 1Q 0Q P) 
	(PUSHJ P NUMVAL)		→ HAND HACK
	(272000Q 5Q 0Q 1Q)		→   (ADDM)
	(HRRZ@ 1Q 0Q P) 		→
	(MOVEM 1Q 0Q P)			→
	(JRST 0Q TAG99) 		→ END HAND HACK
 TAG3 	(SUB P (C 5Q 0Q 5Q 0Q)) 
	(POPJ P) 
	NIL 

(LAP GVAL SUBR) 
	(PUSH P 1Q) 
	(JUMPE 2Q TAG2)
	(MOVEI 2Q (QUOTE SYM) S) 
	(CALL 2Q (E GET) S) 
	(JUMPN 1Q TAG1) 
 TAG2	(MOVEI 2Q (QUOTE UNDEF) S) 
	(MOVE 1Q 0Q P) 
	(CALL 2Q (E GET) S) 
	(MOVE 2Q (SPECIAL L) S) 
	(CALL 2Q (E XCONS) S) 
	(MOVEI 3Q (QUOTE UNDEF) S) 
	(MOVE 2Q 1Q) 
	(MOVE 1Q 0Q P) 
	(CALL 3Q (E PUTPROP) S) 
	(MOVEI 1Q (QUOTE 0Q)) 
 TAG1 	(SUB P (C 1Q 0Q 1Q 0Q)) 
	(POPJ P) 
	NIL 

→ LAP code for OPS and REMLAP removed.

(REMLAP)			→ Remove LAP source code.